home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
netmail
/
cpt152.zip
/
CPT-S152.ZIP
/
NUMDAYS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1996-05-16
|
2KB
|
95 lines
{$N-,E- no math support needed}
{$X- function calls may not be discarded}
{$I- disable I/O checking (trap errors by checking IOResult)}
UNIT NumDays;
INTERFACE
CONST
DaysPerYear = 365;
TYPE
Month = (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
Date = RECORD
da: 1..31;
mo: Month;
yr: 1..9999
END;
VAR
maxDay: ARRAY [Month] OF INTEGER;
daysBefore: ARRAY [Month] OF INTEGER;
PROCEDURE MonthsInit;
FUNCTION IsLeapYear (CONST yr: INTEGER): BOOLEAN;
FUNCTION NumOfDays (CONST D: Date): LONGINT;
{ contains FUNCTION IsLeapYear(Const yr: INTEGER): BOOLEAN; }
FUNCTION Num_Days (CONST D: STRING): LONGINT;
IMPLEMENTATION
PROCEDURE MonthsInit;
VAR mo: Month;
BEGIN
maxDay [Jan] := 31;
maxDay [Feb] := 28; (* adjust for leap years later *)
maxDay [Mar] := 31;
maxDay [Apr] := 30;
maxDay [May] := 31;
maxDay [Jun] := 30;
maxDay [Jul] := 31;
maxDay [Aug] := 31;
maxDay [Sep] := 30;
maxDay [Oct] := 31;
maxDay [Nov] := 30;
maxDay [Dec] := 31;
daysBefore [Jan] := 0;
FOR mo := Jan TO Nov DO
daysBefore [Month (Ord (mo) + 1) ] := daysBefore [mo] + maxDay [mo]
END;
FUNCTION IsLeapYear (CONST yr: INTEGER): BOOLEAN;
BEGIN
IsLeapYear := ((yr MOD 4 = 0) AND (yr MOD 100 <> 0)) OR (yr MOD 400 = 0)
END;
FUNCTION NumOfDays (CONST D: Date): LONGINT;
(* NumOfDays returns an ordinal value for the date
with January 1, 0001 assigned the value 1. *)
VAR result, lYr: LONGINT;
BEGIN
WITH D DO BEGIN
lYr := yr - 1;
result := (da);
Inc (result, daysBefore [mo]);
Inc (result, lYr * DaysPerYear);
Inc (result, ((lYr DIV 4) - (lYr DIV 100) + (lYr DIV 400)));
IF (mo > Feb) AND IsLeapYear (yr) THEN Inc (result)
END;
NumOfDays := result
END;
FUNCTION Num_Days (CONST D: STRING): LONGINT;
VAR
dateRec : Date;
Tmonth,
VErr : INTEGER;
BEGIN
WITH dateRec DO BEGIN
Val (Copy (D, 4, 2), da, VErr);
Val (Copy (D, 1, 2), Tmonth, VErr);
mo := Month (TMonth - 1);
Val (Copy (D, 7, 2), yr, VErr);
if yr >= 80
then yr := 1900 + yr {assume 1980-1999, rather than 2080-2099}
else yr := 2000 + yr
END;
Num_Days := NumOfDays (dateRec);
END;
BEGIN
MonthsInit { for NumDays procedure }
END.